Delphi Developer's Kit 1996/Delphi Developer's Kit 1996.iso/power/add123/u123.pas

Pascal/Delphi Source File | 1995-12-22 | 23.1 KB | 751 lines

UNIT U123;  {Soure PC MAG. DECEMBER 13 1988... and others}
            { YES !  I did it in TP seven years Ago !!!}

INTERFACE

{
This routines ARE simple to use as 123.. :-)
1)  Open the file
2)  Add what you want.. where you want
3)  Close the File
}

PROCEDURE Open123(n:string);
PROCEDURE Close123;
PROCEDURE ColW123(c:integer; a:byte);
PROCEDURE Add123Int(c,f:integer; v:integer);
PROCEDURE Add123Rea(c,f:integer; v:double);
PROCEDURE Add123TXC(c,f:integer; v:string);
PROCEDURE Add123TXL(c,f:integer; v:string);
PROCEDURE Add123TXR(c,f:integer; v:string);
PROCEDURE Add123FML(c,f:integer; s:string);

{
  Open123(n:string);
  n = File Name WITHOUT EXTENSION it ALways add WK1
  It didn't check for a valid File Name or Existing, is
  YOUR responsability to do that


  Close123;
  Close the Open File .. Always DO THIS !

  In the rest of PROCEDURES c=Column and f=Row
  c and F begins with 0 (cero)
  if you want to Add in cell A1, use c=0 f=0
  if you want to Add in cell B2, use c=1 f=1
  etc.


  Add123Int(c,f:integer; v:integer);
  Add a Integer value (v) in Col=c  Row=f

  Add123Rea(c,f:integer; v:double);
  Add a Double value (v) in Col=c  Row=f

  Add123TXC(c,f:integer; v:string);
  Add a Label (v) in Col=C  Row=f
  - Label CENTER -

  Add123TXR(c,f:integer; v:string);
  Add a Label (v) in Col=C  Row=f
  - Label at RIGHT -

  Add123TXL(c,f:integer; v:string);
  Add a Label (v) in Col=C  Row=f
  - Label at LEFT -

  ColW123(c:integer; a:byte);
  Change width of Col=c to size=a

  Add123FML(c,f:integer; s:string);
  Add Formula (s) at Col=c  Row=f

  Examples:
           Add123FML(0,0,'A5+B2+A3*C5');
           Add123FML(0,1,'@Sum(B1..B8)');

  ==========================================
  THE ONLY VALID @ function is SUM   !!!!
  Sorry :-(
  ==========================================

}


{ The rest of Comments are in SPANISH ... Sorry again }


IMPLEMENTATION
CONST
     C00 = $00;
     CFF = $FF;

VAR
   ALotus : File;

PROCEDURE Open123(n:string);

Type
    Abre = record
                   Cod  : integer;
                   Lon  : integer;
                   Vlr  : integer;
             end;

Var
   Formato  : array[1..6] of byte;
   Registro : Abre absolute Formato;


Begin
     Assign(ALotus,n+'.WK1');
     Rewrite(ALotus,1);
     with Registro do
     begin
          Cod:=0;
          Lon:=2;
          Vlr:=1030;
     end;
     BlockWrite(ALotus,Formato[1],6);
End;

PROCEDURE Close123;

Type
    Cierra = record
                   Cod  : integer;
                   Lon  : integer;
             end;

Var
   Formato  : array[1..4] of byte;
   Registro : Cierra absolute Formato;


Begin
     with Registro do
     begin
          Cod:=1;
          Lon:=0;
     end;
     BlockWrite(ALotus,Formato[1],4);
     Close(ALotus);
End;

PROCEDURE ColW123(c:integer; a:byte);

Type
    Ancho = record
                   Cod  : integer;
                   Lon  : integer;
                   Col  : integer;
                   Anc  : byte;
             end;

Var
   Formato  : array[1..7] of byte;
   Registro : Ancho absolute Formato;


Begin
     with Registro do
     begin
          Cod:=8;
          Lon:=3;
          Col:=c;
          Anc:=a;
     end;
     BlockWrite(ALotus,Formato[1],7);
End;


PROCEDURE Add123Int(c,f,v:integer);

Type
    Entero = record
                   Cod  : integer;
                   Lon  : integer;
                   Frm  : byte;
                   Col  : integer;
                   Fil  : integer;
                   Vlr  : integer;
             end;

Var
   Formato  : array[1..11] of byte;
   Registro : Entero absolute Formato;

Begin
     with Registro do
     begin
          Cod:=13;
          Lon:=7;
          Frm:=255;
          Fil:=f;
          Col:=c;
          Vlr:=v;
     end;

     Blockwrite(ALotus,Formato[1],11);
End;

PROCEDURE Add123Rea(c,f:integer; v:double);
Type
    Entero = record
                   Cod  : integer;
                   Lon  : integer;
                   Frm  : byte;
                   Col  : integer;
                   Fil  : integer;
                   Vlr  : double;
             end;
Var
   Formato  : array[1..17] of byte;
   Registro : Entero absolute Formato;
Begin
     with Registro do
     begin
          Cod:=14;
          Lon:=13;
          Frm:=2 or 128;
          Fil:=f;
          Col:=c;
          Vlr:=v;
     end;

     Blockwrite(ALotus,Formato[1],17);
End;


PROCEDURE GrabaTXT(c,f:integer; v:string; t:char);
Type
    Entero = record
                   Cod  : integer;
                   Lon  : integer;
                   Frm  : byte;
                   Col  : integer;
                   Fil  : integer;
                   Vlr  : array[1..100] of char;
             end;
Var
   Formato  : array[1..109] of byte;
   Registro : Entero absolute Formato;
   i        : word;
Begin
     with Registro do
     begin
          Cod:=15;
          Lon:=length(v)+7;
          Frm:=255;
          Fil:=f;
          Col:=c;
          Vlr[1]:=t;
          for i:=1 to Length(v) do Vlr[i+1]:=v[i];
          Vlr[i+2]:=chr(0);
     end;
     Blockwrite(ALotus,Formato[1],length(v)+11);
End;

PROCEDURE Add123TXL(c,f:integer; v:string);
begin
     GrabaTXT(c,f,v,'''');
end;
PROCEDURE Add123TXC(c,f:integer; v:string);
begin
     GrabaTXT(c,f,v,'^');
end;
PROCEDURE Add123TXR(c,f:integer; v:string);
begin
     GrabaTXT(c,f,v,'"');
end;






PROCEDURE Add123FML(c,f:integer; s:string);

Type
    Formula = record
                    Cod : integer;                {codigo}
                    Lon : integer;                {longitud}
                    Frm : byte;                   {formato}
                    Col : integer;                {columna}
                    Fil : integer;                {fila}
                    Res : Double;                {resultado de formula}
                    Tma : integer;                {tamanio de formula en bytes}
                    Fml : array[1..2048] of byte; {formula}
              end;
    symbol = (cel,num,arr,mas,men,por,dvs,pot,pa1,pa2);
    consym = set of symbol;

Var
   Formato   : array[1..2067] of byte;
   Registro  : Formula absolute Formato;
   fabs      : boolean;                {flag que indica si ffml es absoluta}
   v,                                  {v    = string 's' sin blancos}
   nro       : string;                 {nro  = numero de ffml}
   cfml,                               {cfml = valor de columna en formula}
   ffml      : word;                   {ffml =   "    " fila     "    "   }
   nfml,                               {nfml =   "    " constante "   "   }
   i,                                  {i    = indice de 'v' (formula) }
   ii,                                 {ii   =    "    " 's'     "     }
   index,                              {index=    "    " Fml}
   j,ret,                              {usados para convertir a numeros}
   len,                                {len  = longitud de 'v'}
   lens      : integer;                {lens =     "     " 's'}
   sym       : symbol;                 {sym  = ultimo simbolo leido}
   symsig,                             {usados para analizar formula para }
   syminifac : consym;                 {grabarla con notacion posfija     }
   z         : byte;                   {indice para inicializar array}


   Procedure CalculaDir(var Reg : Formula);

   var
      veces : integer;

      (*   Primero, se decide si cfml es absoluta o relativa. Si es absoluta
           calcula el valor real. Si es relativa primero chequea si cfml<col.
           Si cfml<col le resta cfml a 49152 (C000); este numero es usado por
           Lotus para calcular la direccion de una celda a la izquierda de
           donde esta parado. Si col<=cfml le suma cfml a 32768 para encender
           el MSB que indica que es relativa (la C tambien lo prende).

           Segundo, se procede de la misma manera con ffml para determinar si
           es absoluta o relativa, y despues se calcula la direccion en base
           a eso y a la relacion de ffml con fil.
      *)

   begin
        with Reg do
        begin
             if v[i]='$' then             {calcula la columna (cfml)}
             begin
                  inc(i);
                  cfml:=ord(v[i])-ord('A');
                  inc(i);
                  while (v[i] in ['A'..'Z']) and (len>=i) do
                  begin
                       cfml:=(cfml+1)*26+ord(v[i])-ord('A');
                       inc(i);
                  end;
             end
             else
             begin
                  if (ord(v[i])-ord('A') < col) then
                  begin
                       cfml:=49152-col+(ord(v[i])-ord('A'));
                       inc(i);
                       veces:=1;
                       while (v[i] in ['A'..'Z']) and (len>=i) do
                       begin
                            cfml:=49152-col+(26*veces)+(ord(v[i])-ord('A'));
                            cfml:=cfml+((ord(v[i-1])-ord('A'))*26);
                            inc(i);
                            inc(veces);
                       end;
                  end
                  else
                  begin
                       cfml:=ord(v[i])-ord('A');
                       inc(i);
                       while (v[i] in ['A'..'Z']) and  (len>=i) do
                       begin
                            cfml:=(cfml+1)*26+ord(v[i])-ord('A');
                            inc(i);
                       end;
                       cfml:=cfml+32768-col;
                  end;
             end;

             Fml[index]:=Lo(cfml);        {graba cfml}
             inc(index);                  {que posee }
             Fml[index]:=Hi(cfml);        {dos bytes }
             inc(index);

             if v[i]='$' then             {calcula la fila (ffml)}
             begin
                  inc(i);
                  fabs:=true;
             end
             else
                 fabs:=false;
             j:=i;
             while (v[i] in ['0'..'9']) and (len>=i) do
             begin
                  inc(i);
             end;
             nro:=copy(v,j,i-j);
             val(nro,ffml,ret);

             if fabs then                 {siempre se resta 1 por estar en base 0}
             begin
                  if ffml>0 then ffml:=ffml-1;
             end
             else
             begin
                  if fil<ffml then
                  begin
                       ffml:=32768+abs(ffml-fil)-1;
                  end
                  else
                  begin
                       ffml:=49152-abs(ffml-fil)-1;
                  end;
             end;

             Fml[index]:=Lo(ffml);        {graba ffml}
             inc(index);                  {que posee }
             Fml[index]:=Hi(ffml);        {dos bytes }
             inc(index);
        end;
   end;

   Procedure CalculaNum(var Reg : Formula);

   var
      VDoble  : array[1..8] of byte;
      dfml    : Double absolute VDoble;
      d       : real;
      esreal  : boolean;
      k       : byte;
      numero  : longint;
      codigo  : integer;

   begin
        with Reg do
        begin
             esreal:=false;
             j:=i;
             while (v[i] in ['0'..'9','.']) and (len>=i) do
             begin
                  if v[i]='.' then esreal:=true;
                  inc(i);
             end;
             nro:=copy(v,j,i-j);
             {R-}
                 val(nro,numero,codigo);
             {R+}
                 if (codigo=0) and (numero>=-32768) and (numero<=32767) then
                    esreal:=false
                 else
                     esreal:=true;

             if esreal then
             begin
                  val(nro,d,ret);             {convierte en real doble}
                  dfml:=d;
                  {ConvRD(d,dfml);}

                  Fml[index]:=0;              {0 = indica que sigue una constante}
                  inc(index);                 {    real doble precision (8 bytes)}
                  for k:=1 to 8 do
                  begin
                       Fml[index]:=VDoble[k];   {graba dfml}
                       inc(index);            {son ocho bytes}
                  end;
             end
             else
             begin
                  val(nro,nfml,ret);          {convierte en entero}

                  Fml[index]:=5;              {5 = indica que sigue una constante }
                  inc(index);                 {    entera con signo (2 bytes)     }
                  Fml[index]:=Lo(nfml);       {graba nfml}
                  inc(index);                 {son dos bytes}
                  Fml[index]:=Hi(nfml);
                  inc(index);
             end;
             dec(i);
        end;
   end;

   Procedure CalculaRan(var Reg : Formula);

   begin
        with Reg do
        begin
             Fml[index]:=2;               {2 = codigo de rango; le sigue 8 bytes}
             inc(index);                  {    que son (col1fil1..col2fil2)     }

             CalculaDir(Reg);             {calcula col1fil1}
             i:=i+2;                      {salta los 2 ..  }
             CalculaDir(Reg);             {calcula col2fil2}
        end;
   end;

   Procedure CalculaArr(var Reg : Formula);

   {** SOLO CODIFICA @TRUE,@FALSE,@SUM(COL1FIL1..COL2FIIL2) **}

   var
      func,dir : string;                  {func  = string del @}
                                          {dir   = del rango}
      N_arg,nc : byte;                    {N_arg = cantidad de argumentos}
                                          {nc    = numero de codigo (T,F,S)}

   begin
        with Reg do
        begin
             inc(i);
             case v[i] of
                         'F' : nc:=51;
                         'T' : nc:=52;
                         'S' : nc:=80;
             end;

             while (v[i] in ['A'..'Z']) and (len>=i) do inc(i);
             inc(i);
             if nc=80 then
             begin
                  CalculaRan(Reg);        {calcula el rango (col1fil1..col2fil2}
                  N_arg:=1;               {hay un solo argumento}
             end;

             Fml[index]:=nc;
             inc(index);
             if nc=80 then
             begin
                  Fml[index]:=N_arg;      {graba numero de argumentos}
                  inc(index);
             end;
        end;
   end;

   Procedure TraerChar;

   begin
        inc(i);                           {carga el simbolo para }
        if len>=i then                    {la recursividad       }
        begin
             case v[i] of
                         'A'..'Z','$' : sym:=cel;
                         '0'..'9','.' : sym:=num;
                         '@'          : sym:=arr;
                         '+'          : sym:=mas;
                         '-'          : sym:=men;
                         '*'          : sym:=por;
                         '/'          : sym:=dvs;
                         '^'          : sym:=pot;
                         '('          : sym:=pa1;
                         ')'          : sym:=pa2;
             end;
        end;
   end;


   Procedure Expresion(symsig : consym; var Reg : Formula);
   var
      opsuma:symbol;

   Procedure Termino(symsig : consym; var Reg : Formula);
   var
      opmul:symbol;

   Procedure Factor(symsig : consym; var Reg : Formula);
   var
      opexp:symbol;

   Procedure Exponente(symsig : consym; var Reg : Formula);

   begin{Exponente}
        while (sym in syminifac) and (len>=i) do
        begin
             case sym of
                        num : begin
                                   CalculaNum(Registro);
                                   TraerChar;
                              end;
                        cel : begin
                                   Reg.Fml[index]:=1;
                                   inc(index);
                                   CalculaDir(Registro);
                                   dec(i);
                                   TraerChar;
                              end;
                        arr : begin
                                   CalculaArr(Registro);
                                   TraerChar;
                              end;
             else
                 begin
                      if sym=pa1 then
                      begin
                           TraerChar;
                           Expresion([pa2]+symsig,Registro);
                           if sym=pa2 then
                           begin
                                Reg.Fml[index]:=4;       {4 = simbolo '(' }
                                inc(index);
                                TraerChar;
                           end;
                      end;
                 end;
             end;
        end;
   end;{Exponente}

   begin{Factor}
        Exponente(symsig+[pot],Registro);
        while (sym=pot) and (len>=i) do
        begin
             opexp:=sym;
             TraerChar;
             Exponente(symsig+[pot],Registro);
             if opexp=pot then
             begin
                  Reg.Fml[index]:=13;                    {13 = simbolo '^' }
                  inc(index);
             end;
        end;
   end;{Factor}

   begin{Termino}
        Factor(symsig+[por,dvs],Registro);
        while (sym in [por,dvs]) and (len>=i) do
        begin
             opmul:=sym;
             TraerChar;
             Factor(symsig+[por,dvs],Registro);
             if (opmul=por) or (opmul=dvs) then
             begin
                  if opmul=por then Reg.Fml[index]:=11   {11 = simbolo '*' }
                  else
                      Reg.Fml[index]:=12;                {12 = simbolo '/' }
                  inc(index);
             end;
        end;
   end;{Termino}

   begin{Expresion}

      (*   Este es el primero de cuatro procedimientos recursivos (Expresion,
           Termino, Factor y Exponente) que se usan para transformar la formula
           en una expresion en notacion posfija, tal como se debe grabar. La
           tecnica consiste en retrasar la transmision del operador aritmetico.
           Ejemplo:  a+(b*c)^d  ==>  abc*(d^+  .

           Expresion analiza si es suma o resta. Luego llama a Termino. Al
           volver trae el proximo dato y llama otra vez a Termino. Al volver
           genera el codigo de suma o resta si hubo.

           Termino llama a Factor. Al volver trae el proximo dato y llama otra
           vez a Factor. Al volver genera el codigo de multiplicacion o division
           si hubo.

           Factor llama a Exponente. Al volver trae el proximo dato y llama
           otra vez a Exponente. Cuando vuele genera el codigo de exponenciacion
           si hubo.

           Exponente analiza si el valor es un numero, una celda, un arroba o
           un parentesis. Si es un parentesis, vuelve a llamar a Expresion para
           calcular el contenido este; sino genera el codigo correspondiente.

      *)

        if sym in [mas,men] then
        begin
             opsuma:=sym;
             TraerChar;
             Termino(symsig+[mas,men],Registro);
             if opsuma=men then
             begin
                  Reg.Fml[index]:=8;                     {8 = simbolo '-' unario}
                  inc(index);
             end;
        end
        else
            Termino(symsig+[mas,men],Registro);
        while (sym in [mas,men]) and (len>=i) do
        begin
             opsuma:=sym;
             TraerChar;
             Termino(symsig+[mas,men],Registro);
             if (opsuma=mas) or (opsuma=men) then
             begin
                  if opsuma=mas then Reg.Fml[index]:=9   { 9 = simbolo '+' }
                  else
                      Reg.Fml[index]:=10;                {10 = simbolo '-' }
                  inc(index);
             end;
        end;
   end;{Expresion}


Begin
     with Registro do
     begin
          Cod:=16;                     {16= formula}
          Col:=c;
          Fil:=f;

          Frm:=0;                      {Comienzo con 0}
(*
          if p=true then Frm:=Frm+128; {Si se protege se prende el MSB}

          ch:=UpCase(ch);              {Veo que formato se quiere y prendo }
                                       {los bits respectivos               }
          case ch of
                   'F' : Frm:=Frm+  0; {'F' ==> decimales fijos    }
                   'S' : Frm:=Frm+ 16; {'S' ==> notacion cientifica}
                   'C' : Frm:=Frm+ 32; {'C' ==> moneda corriente   }
                   'P' : Frm:=Frm+ 48; {'P' ==> porcentaje         }
                   'M' : Frm:=Frm+ 64; {',' ==> miles con comas    }
                   'O' : Frm:=Frm+112; {'O' ==> otros              }
          end;

          Frm:=Frm+d;                  {Si ch<>'O' ==> d= cant. de decimales}
                                       {Si ch= 'O' ==> d= 1 --> general     }
                                       {                  2 --> DD/MMM/AA   }
                                       {                  3 --> DD/MMM      }
                                       {                  4 --> MM/AA       }
                                       {                  5 --> texto       }
                                       {                  6 --> hidden      }
                                       {                  7 --> date; HH-MM-SS}
                                       {                  8 --> date; HH-MM }
                                       {                  9 --> date; int'l 1 }
                                       {                 10 --> date; int'l 2 }
                                       {                 11 --> time; int'l 1 }
                                       {                 12 --> time; int'l 2 }
                                       {              13-14 --> no utilizado}
                                       {                 15 --> default     }

  *)
           Res:=C00;
{          for z:=1 to 8 do Res[z]:=C00;} {se modifica automaticamente cuando se recalcula y regraba}

          lens:=length(s);             {convierto todo a mayusculas}
          for ii:=1 to lens do s[ii]:=UpCase(s[ii]);
          i:=1;
          v:='';
          for ii:=1 to lens do         {paso el string 's' al string 'v' }
          begin                        {eliminando los espacios en blanco}
               if s[ii]<>' ' then
               begin
                    v:=v+s[ii];
                    inc(i);
               end;
          end;

          len:=i-1;
          i:=0;
          index:=1;

          syminifac:=[cel,num,arr,pa1];
          symsig:=syminifac;

          TraerChar;                   {toma el primer caracter de formula}
          Expresion(symsig,Registro);  {analiza y graba toda la formula}

          Fml[index]:=3;               {3 = fin de formula}
          Tma:=index;                  {tamanio de Fml}
          Lon:=15+Tma;                 {longitud de dato}
          BlockWrite(ALotus,Formato[1],19+index);
     end;
End;


END.